Shareware Grab Bag/Shareware Grab Bag.iso/007/tsr25src.arc/RELEASE.PAS

Pascal/Delphi Source File | 1987-06-02 | 32KB | 915 lines

{**************************************************************************
*   Releases memory above the last MARK call made.                        *
*   Copyright (c) 1986 Kim Kokkonen, TurboPower Software.                 *
*   Released to the public domain for personal, non-commercial use only.  *
***************************************************************************
*   Version 1.0 2/8/86                                                    *
*     original public release                                             *
*     (thanks to Neil Rubenking for an outline of the method used)        *
*   Version 1.1 2/11/86                                                   *
*     fixed problem with processes which deallocate their environment     *
*   Version 1.2 2/13/86                                                   *
*     fixed another problem with processes which deallocate environment   *
*   Version 1.3 2/15/86                                                   *
*     add support for "named" marks                                       *
*   Version 1.4 2/23/86                                                   *
*     add support for releasing programs which use Expanded Memory        *
*   Version 1.5 2/28/86                                                   *
*     add more bulletproof method of finding first allocation block       *
*   Version 1.6 3/20/86                                                   *
*     restore all FF interrupts.                                          *
*     restore the termination address to the local process                *
*     reduce number of EMS blocks to 32.                                  *
*     fix bug in number of EMS handles in EMS release step                *
*     restore an undocumented address in the PSP which allows RELEASE of  *
*       a COMMAND shell (emulates the EXIT command)                       *
*   Version 1.7 (date not recorded)                                       *
*     add "protected" marks                                               *
*   Version 1.8 4/21/86                                                   *
*     fix problem when mark is installed as 'MARK '                       *
*   Version 1.9 5/22/86                                                   *
*     release the environment of MARK when it is not contiguous with      *
*       the MARK itself                                                   *
*     capture RELEASE calls from within batch files and don't release the *
*       batch control block                                               *
*     fiddle with different methods of restoring interrupt vectors in     *
*       an attempt to successfully remove DoubleDos. No success, not      *
*       implemented. Note, after more effort: DDos apparently             *
*       reprograms the 8259 as well as patching the operating system      *
*   Version 2.0 6/17/86                                                   *
*     support "file" marks placed by the new program FMARK                *
*   Version 2.1 7/18/86                                                   *
*     fix bug in restoring "parent" address in RELEASE PSP                *
*   Version 2.2 3/3/87                                                    *
*     add option to revector 8259 interrupt controller                    *
*       (thanks to Steve Glynn for this code)                             *
*     add option to leave mark in place when RELEASE is run               *
*     restore save areas for EGA and interapplication communications      *
*   Version 2.3 5/2/87                                                    *
*     update watch area, if any, when releasing                           *
*   Version 2.4 5/17/87                                                   *
*     avoids use of EMS call $4B, which doesn't work in many EMS          *
*       implementations                                                   *
*     adds switch to ignore EMS altogether                                *
*   Version 2.5 6/2/87                                                    *
*     check version number of mark to avoid incompatibilities             *
*                                                                         *
***************************************************************************
*   telephone: [phone], CompuServe: 72457,2131.                      *
*   requires Turbo version 3 to compile.                                  *
*   Compile with mAx dynamic memory = FFFF.                               *
***************************************************************************}

{$P128}
{$C-}

program ReleaseTSR;
  {-Release system memory above the last mark call}
  {-Release expanded memory blocks allocated since the last mark call}

const
  Version = '2.5';
  ProtectChar = '!';          {Marks whose name begins with this will be
                              released ONLY if an exact name match occurs}
  MaxBlocks = 128;            {Max number of DOS allocation blocks supported}
  MaxHandles = 32;            {Max number of EMS allocation blocks supported}
  EMSinterrupt = $67;         {The vector used by the expanded memory manager}

  MarkID = 'M2.5 PARAMETER BLOCK FOLLOWS'; {Marking string for TSR MARK}
  FmarkID = 'FM2.5 TSR';      {Marking string for TSR file mark}

  {Offsets into resident copy of MARK.COM for data storage}
  MarkOffset = $103;          {Where markID is found in MARK TSR}
  FmarkOffset = $60;          {Where fmarkID is found in FMARK TSR}
  VectorOffset = $120;        {Where vector table is stored}
  EGAsavOffset = $520;        {Where the EGA save save is stored}
  IntComOffset = $528;        {Where the interapps comm area is stored}
  EMScntOffset = $538;        {Where count of EMS active pages is stored}
  EMSmapOffset = $53A;        {Where the page map is stored}

  WatchID = 'TSR WATCHER';    {Marking string for WATCH}

  {Offsets into resident copy of WATCH.COM for data storage}
  WatchOffset = $81;
  NextChange = $104;
  ChangeVectors = $220;
  OrigVectors = $620;
  CurrVectors = $A20;
  MaxChanges = 128;           {Maximum number of vector changes stored in WATCH}

type
  Registers =
  record
    case Integer of
      1 : (ax, bx, cx, dx, bp, si, di, ds, es, flags : Integer);
      2 : (al, ah, bl, bh, cl, ch, dl, dh : Byte);
  end;

  HandlePageRecord =
  record
    handle : Integer;
    numpages : Integer;
  end;

  PageArray = array[1..MaxHandles] of HandlePageRecord;
  PageArrayPtr = ^PageArray;

  Block =
  record                      {Store info about each memory block}
    mcb : Integer;
    psp : Integer;
    releaseIt : Boolean;
  end;

  BlockType = 0..MaxBlocks;
  BlockArray = array[BlockType] of Block;

  HexString = string[4];
  Pathname = string[64];
  AllStrings = string[255];

var
  Blocks : BlockArray;
  watchBlock, bottomBlock, blockNum : BlockType;

  markName : AllStrings;
  Regs : Registers;

  FilMarkHandles, ReturnCode, StartMCB, StoredHandles, EMShandles : Integer;
  UseWatch, Debug, Revector8259, DealWithEMS,
  KeepMark, MemMark, FilMark, Junk : Boolean;

  FilMarkPageMap, Map, StoredMap : PageArrayPtr;
  TrappedBytes : Real;

  {Save areas read in from file mark}
  Vectors : array[0..1023] of Byte;
  EGAsavTable : array[0..7] of Byte;
  IntComTable : array[0..15] of Byte;

  procedure Abort(msg : AllStrings);
    {-Halt in case of error}
  begin
    WriteLn(msg);
    Halt(1);
  end {Abort} ;

  procedure Halt(ReturnCode : Integer);
    {-Replace Turbo halt with one that doesn't restore any interrupts}
  begin
    Close(Output);
    with Regs do begin
      ah := $4C;
      al := Lo(ReturnCode);
      MsDos(Regs);
    end;
  end {Halt} ;

  procedure FindTheBlocks;
    {-Scan memory for the allocated memory blocks}
  const
    MidBlockID = $4D;         {Byte DOS uses to identify part of MCB chain}
    EndBlockID = $5A;         {Byte DOS uses to identify last block of MCB chain}
  var
    mcbSeg : Integer;         {Segment address of current MCB}
    nextSeg : Integer;        {Computed segment address for the next MCB}
    gotFirst : Boolean;       {True after first MCB is found}
    gotLast : Boolean;        {True after last MCB is found}
    idbyte : Byte;            {Byte that DOS uses to identify an MCB}

    function GetStartMCB : Integer;
      {-Return the first MCB segment}
    begin
      Regs.ah := $52;
      MsDos(Regs);
      GetStartMCB := MemW[Regs.es:(Regs.bx-2)];
    end {Getstartmcb} ;

    procedure StoreTheBlock(var mcbSeg, nextSeg : Integer;
                            var gotFirst, gotLast : Boolean);
      {-Store information regarding the memory block}
    var
      nextID : Byte;
      pspAdd : Integer;       {Segment address of the current PSP}
      mcbLen : Integer;       {Size of the current memory block in paragraphs}

    begin

      mcbLen := MemW[mcbSeg:3]; {Size of the MCB in paragraphs}
      nextSeg := Succ(mcbSeg+mcbLen); {Where the next MCB should be}
      pspAdd := MemW[mcbSeg:1]; {Address of program segment prefix for MCB}
      nextID := Mem[nextSeg:0];

      if gotLast or (nextID = EndBlockID) or (nextID = MidBlockID) then begin
        blockNum := Succ(blockNum);
        gotFirst := True;
        with Blocks[blockNum] do begin
          mcb := mcbSeg;
          psp := pspAdd;
        end;
      end;

    end {Storetheblock} ;

  begin

    {Initialize}
    StartMCB := GetStartMCB;
    mcbSeg := StartMCB;
    gotFirst := False;
    gotLast := False;
    blockNum := 0;

    {Scan all memory until the last block is found}
    repeat
      idbyte := Mem[mcbSeg:0];
      if idbyte = MidBlockID then begin
        StoreTheBlock(mcbSeg, nextSeg, gotFirst, gotLast);
        if gotFirst then
          mcbSeg := nextSeg
        else
          mcbSeg := Succ(mcbSeg);
      end else if gotFirst and (idbyte = EndBlockID) then begin
        gotLast := True;
        StoreTheBlock(mcbSeg, nextSeg, gotFirst, gotLast);
      end else
        {Start block was invalid}
        Abort('Corrupted allocation chain or program error....');
    until gotLast;

  end {Findtheblocks} ;

  function StUpcase(s : AllStrings) : AllStrings;
    {-Return the uppercase string}
  var
    i : Byte;

  begin
    for i := 1 to Length(s) do
      s[i] := UpCase(s[i]);
    StUpcase := s;
  end {Stupcase} ;

  function FindMark(markName, MarkID : AllStrings;
                    MarkOffset : Integer;
                    var MemMark, FilMark : Boolean;
                    var b : BlockType) : Boolean;
    {-Find the last memory block matching idstring at offset idoffset}

    function HasIDstring(segment : Integer;
                         idString : AllStrings;
                         idOffset : Integer) : Boolean;
      {-Return true if idstring is found at segment:idoffset}
    var
      tString : AllStrings;
      len : Byte;
    begin
      len := Length(idString);
      tString[0] := Chr(len);
      Move(Mem[segment:idOffset], tString[1], len);
      HasIDstring := (tString = idString);
    end {HasIDstring} ;

    function GetMarkName(segment : Integer) : AllStrings;
      {-Return a cleaned up mark name from the segment's PSP}
    var
      tString : AllStrings;
      tlen : Byte absolute tString;
    begin
      Move(Mem[segment:$80], tString[0], 128);
      while (tlen > 0) and ((tString[1] = ' ') or (tString[1] = ^I)) do
        Delete(tString, 1, 1);
      while (tlen > 0) and ((tString[tlen] = ' ') or (tString[tlen] = ^I)) do
        tlen := Pred(tlen);
      GetMarkName := StUpcase(tString);
    end;                      {GetMarkName}

    function MatchMemMark(segment : Integer;
                          markName : AllStrings;
                          var b : BlockType) : Boolean;
      {-Return true if MemMark is unnamed or matches current name}
    var
      tString : AllStrings;
      FoundIt : Boolean;
    begin
      {Check the mark name stored in the PSP of the mark block}
      tString := GetMarkName(segment);
      if (markName <> '') then begin
        FoundIt := (tString = StUpcase(markName));
        if not(FoundIt) then
          if (tString <> '') and (tString[1] = ProtectChar) then
            {Current mark is protected, stop searching}
            b := 1;
      end else if (tString <> '') and (tString[1] = ProtectChar) then begin
        {Stored mark name is protected}
        FoundIt := False;
        {Stop checking}
        b := 1;
      end else
        {Match any mark}
        FoundIt := True;
      if not(FoundIt) then
        b := Pred(b);
      MatchMemMark := FoundIt;
    end {MatchMemMark} ;

    function MatchFilMark(segment : Integer;
                          markName : AllStrings;
                          var b : BlockType) : Boolean;
      {-Return true if FilMark is unnamed or matches current name}
    var
      tString : AllStrings;
      FoundIt : Boolean;

      function ExistFile(path : AllStrings) : Boolean;
        {-Return true if file exists}
      var
        f : file;
      begin
        Assign(f, path);
        {$I-}
        Reset(f);
        {$I+}
        ExistFile := (IOResult = 0);
        Close(f);
      end;                    {Existfile}

    begin
      {Check the mark name stored in the PSP of the mark block}
      tString := GetMarkName(segment);
      if (markName <> '') then begin
        markName := StUpcase(markName);
        FoundIt := (tString = markName);
        if FoundIt then begin
          {Assure named file exists}
          WriteLn('Finding mark file ', markName);
          FoundIt := ExistFile(markName);
          if not(FoundIt) then
            {Stop checking}
            b := 1;
        end;
      end else
        {File marks must be named on RELEASE command line}
        FoundIt := False;
      if not(FoundIt) then
        b := Pred(b);
      MatchFilMark := FoundIt;
    end {MatchFilMark} ;

  begin
    {Scan from the last block down to find the last MARK TSR}
    b := blockNum;
    MemMark := False;
    FilMark := False;
    repeat
      if Blocks[b].psp = CSeg then
        {Assure this program's command line is not matched}
        b := Pred(b)
      else if HasIDstring(Blocks[b].psp, MarkID, MarkOffset) then
        {An in-memory mark}
        MemMark := MatchMemMark(Blocks[b].psp, markName, b)
      else if HasIDstring(Blocks[b].psp, FmarkID, FmarkOffset) then
        {A file mark}
        FilMark := MatchFilMark(Blocks[b].psp, markName, b)
      else
        {Not a mark}
        b := Pred(b);
    until (b < 1) or MemMark or FilMark;
    FindMark := MemMark or FilMark;
  end {Findmark} ;

  function Hex(i : Integer) : HexString;
    {-Return hex representation of integer}
  const
    hc : array[0..15] of Char = '0123456789ABCDEF';
  var
    l, h : Byte;
  begin
    l := Lo(i);
    h := Hi(i);
    Hex := hc[h shr 4]+hc[h and $F]+hc[l shr 4]+hc[l and $F];
  end {Hex} ;

  procedure ReadMarkFile(markName : AllStrings);
    {-Read the mark file info into memory}
  var
    f : file;
  begin
    Assign(f, markName);
    Reset(f, 1);

    {Read the vector table from the mark file, into a temporary memory area}
    BlockRead(f, Vectors, 1024);

    {Read the BIOS miscellaneous save areas into temporary tables}
    BlockRead(f, EGAsavTable, 8);
    BlockRead(f, IntComTable, 16);

    {Read the number of EMS handles stored}
    BlockRead(f, FilMarkHandles, 2);

    {Get a page map area and read the page map into it}
    GetMem(FilMarkPageMap, 4*FilMarkHandles);
    BlockRead(f, FilMarkPageMap^, 4*FilMarkHandles);
    Close(f);

    if not(KeepMark) then
      {Delete the mark file so it causes no mischief later}
      Erase(f);
  end {ReadMarkFile} ;

  procedure CopyVectors(bottomBlock : BlockType);
    {-Put interrupt vectors back into table}
  var
    bottompsp : Integer;

    procedure Reset8259;
      {-Reset the 8259 interrupt controller to its powerup state}
      {-Interrupts assumed OFF prior to calling this routine}

      function ATmachine : Boolean;
        {-Return true if machine is AT class}
      var
        machtype : Byte absolute $FFFF : $000E;
      begin
        ATmachine := (machtype = $FC);
      end {ATmachine} ;

      procedure Reset8259PC;
        {-Reset the 8259 on a PC class machine}
      begin
        inline(
          $E4/$21/            { in      al,$21}
          $88/$C4/            { mov     ah,al}
          $B0/$13/            { mov     al,+$13}
          $E6/$20/            { out     $20,al}
          $B0/$08/            { mov     al,+$08}
          $E6/$21/            { out     $21,al}
          $B0/$09/            { mov     al,+$09}
          $E6/$21/            { out     $21,al}
          $88/$E0/            { mov     al,ah}
          $E6/$21             { out     $21,al}
          );
      end {Reset8259PC} ;

      procedure Reset8259AT;
        {-Reset the 8259 interrupt controllers on an AT machine}
      begin
        inline(
          $32/$C0/            { xor       al,al }
          $E6/$F1/            { out       0f1h,al         ; Switch off an 80287 if necessary}
          {Set up master 8259 }
          $E4/$21/            { in        al,21h          ; Get current interrupt mask }
          $8A/$E0/            { mov       ah,al           ; save it }
          $B0/$11/            { mov       al,11h }
          $E6/$20/            { out       20h,al }
          $EB/$00/            { jmp       short $+2 }
          $B0/$08/            { mov       al,8            ; Set up main interrupt vector number}
          $E6/$21/            { out       21h,al }
          $EB/$00/            { jmp       short $+2 }
          $B0/$04/            { mov       al,4 }
          $E6/$21/            { out       21h,al }
          $EB/$00/            { jmp       short $+2 }
          $B0/$01/            { mov       al,1 }
          $E6/$21/            { out       21h,al }
          $EB/$00/            { jmp       short $+2 }
          $8A/$C4/            { mov       al,ah }
          $E6/$21/            { out       21h,al }
          {Set up slave 8259 }
          $E4/$A1/            { in        al,0a1h         ; Get current interrupt mask }
          $8A/$E0/            { mov       ah,al           ; save it }
          $B0/$11/            { mov       al,11h }
          $E6/$A0/            { out       0a0h,al }
          $EB/$00/            { jmp       short $+2 }
          $B0/$70/            { mov       al,70h }
          $E6/$A1/            { out       0a1h,al }
          $B0/$02/            { mov       al,2 }
          $EB/$00/            { jmp       short $+2 }
          $E6/$A1/            { out       0a1h,al }
          $EB/$00/            { jmp       short $+2 }
          $B0/$01/            { mov       al,1 }
          $E6/$A1/            { out       0a1h,al }
          $EB/$00/            { jmp       short $+2 }
          $8A/$C4/            { mov       al,ah           ; Reset previous interrupt state }
          $E6/$A1             { out       0a1h,al }
          );
      end {Reset8259AT} ;

    begin
      if ATmachine then
        Reset8259AT
      else
        Reset8259PC;
    end {Reset8259} ;

  begin

    {Interrupts off}
    inline($FA);

    {Reset 8259 if requested}
    if Revector8259 then
      Reset8259;

    {Restore the main interrupt vector table and the misc save areas}
    if FilMark then begin
      Move(Vectors, Mem[0:0], 1024);
      Move(EGAsavTable, Mem[$40:$A8], 8);
      Move(IntComTable, Mem[$40:$F0], 16);
    end else begin
      bottompsp := Blocks[bottomBlock].psp;
      Move(Mem[bottompsp:VectorOffset], Mem[0:0], 1024);
      Move(Mem[bottompsp:EGAsavOffset], Mem[$40:$A8], 8);
      Move(Mem[bottompsp:IntComOffset], Mem[$40:$F0], 16);
    end;

    {Interrupts on}
    inline($FB);

    {Move the old termination/break/error addresses into this program}
    Move(Mem[0:$88], Mem[CSeg:$0A], 12);

    {Restore the "parent address" used by the DOS EXIT command to remove a shell}
    Move(Mem[CSeg:$0C], Mem[CSeg:$16], 2);

  end {CopyVectors} ;

  procedure MarkBlocks(bottomBlock : BlockType);
    {-Mark those blocks to be released}
  var
    b : BlockType;
    commandPsp, markPsp : Integer;
    ch : Char;

    procedure BatchWarning(b : BlockType);
      {-Warn about the trapping effect of batch files}
    var
      t : BlockType;

      function Cardinal(i : Integer) : Real;
        {-Return unsigned integer 0..65535 in a real}
      begin
        if i < 0 then
          Cardinal := 65536.0+i
        else
          Cardinal := i;
      end {Cardinal} ;

    begin
      WriteLn('Memory space for TSRs installed prior to batch file');
      WriteLn('will not be released until batch file completes.');
      WriteLn;
      ReturnCode := 1;
      {Accumulate number of bytes temporarily trapped}
      for t := 1 to b do
        if Blocks[t].releaseIt then
          TrappedBytes := TrappedBytes+16.0*Cardinal(MemW[Blocks[t].mcb:3]);
    end {BatchWarning} ;

  begin

    commandPsp := Blocks[2].psp;
    markPsp := Blocks[bottomBlock].psp;

    for b := 1 to blockNum do
      with Blocks[b] do
        if (b < bottomBlock) then begin
          {Release any trapped environment block}
          if KeepMark then
            releaseIt := (psp <> CSeg) and (psp xor $8000 > markPsp xor $8000)
          else
            releaseIt := (psp <> CSeg) and (psp xor $8000 >= markPsp xor $8000);
        end else if (psp = commandPsp) then begin
          {Don't release blocks owned by COMMAND.COM}
          releaseIt := False;
          BatchWarning(b);
        end else if KeepMark then
          {Release all but RELEASE and the mark}
          releaseIt := (psp <> CSeg) and (psp <> markPsp)
        else
          {Release all but RELEASE itself}
          releaseIt := (psp <> CSeg);

    if Debug then begin
      for b := 1 to blockNum do with Blocks[b] do
        WriteLn(b:3, ' ', Hex(psp), ' ', Hex(mcb), ' ', releaseIt);
      Read(Kbd, ch);
    end;

  end {MarkBlocks} ;

  procedure ReleaseMem;
    {-Release DOS memory marked for release}
  var
    b : BlockType;
  begin
    with Regs do
      for b := 1 to blockNum do
        with Blocks[b] do
          if releaseIt then begin
            ah := $49;
            {The block is always 1 paragraph above the MCB}
            es := Succ(mcb);
            MsDos(Regs);
            if Odd(flags) then begin
              WriteLn('Could not release block at segment ', Hex(es));
              Abort('Memory may be a mess... Please reboot');
            end;
          end;
  end {Releasemem} ;

  procedure UpdateWatch(watchBlock : BlockType);
    {-Write a new watch data area based on the release and the original watch}
  type
    ChangeBlock =
    record
      VecID : Integer;
      VecOfs : Integer;
      VecSeg : Integer;
      PatchWord : Integer;
    end;
  var
    changes : array[0..MaxChanges] of ChangeBlock;
    p : ^ChangeBlock;
    watchseg, c, o, i, actualmax : Integer;
    KeepPSP : Boolean;

    function WillKeepPSP(pspAdd : Integer) : Boolean;
      {-Return true if this psp address will be kept}
    var
      b : BlockType;
    begin
      for b := 1 to blockNum do
        with Blocks[b] do
          if psp = pspAdd then begin
            WillKeepPSP := not(releaseIt);
            Exit;
          end;
    end {WillKeepPSP} ;

  begin

    {Initialize}
    watchseg := Blocks[watchBlock].psp;
    actualmax := MemW[watchseg:NextChange];

    {Transfer changes from WATCH into a buffer array}
    i := 0;
    o := 0;
    while i < actualmax do begin
      p := Ptr(watchseg, ChangeVectors+i);
      Move(p^, changes[o], SizeOf(ChangeBlock));
      i := i+SizeOf(ChangeBlock);
      o := Succ(o);
    end;

    {Determine which change records to keep and transfer them back to WATCH}
    KeepPSP := True;
    i := 0;
    for c := 0 to Pred(o) do begin
      with changes[c] do
        if VecID = $FFFF then
          {This record starts a new PSP. See if PSP is kept in memory}
          KeepPSP := WillKeepPSP(VecOfs);
      if KeepPSP then begin
        p := Ptr(watchseg, ChangeVectors+i);
        Move(changes[c], p^, SizeOf(ChangeBlock));
        i := i+SizeOf(ChangeBlock);
      end;
    end;
    MemW[watchseg:NextChange] := i;

    {Update the WATCH image of the vector table to whatever's current}
    Move(Mem[0:0], Mem[watchseg:CurrVectors], 1024);

  end {UpdateWatch} ;

  function EMSpresent : Boolean;
    {-Return true if EMS memory manager is present}
  var
    f : file;
  begin
    {"file handle" defined by the expanded memory manager at installation}
    Assign(f, 'EMMXXXX0');
    {$I-}
    Reset(f);
    {$I+}
    EMSpresent := (IOResult = 0);
    Close(f);
  end {EMSpresent} ;

  procedure RestoreEMSmap;
    {-Restore EMS to state at time of mark}

    function GetHandles(bottomBlock : BlockType; EMScntOffset : Integer) : Integer;
      {-Return the number of handles stored by mark}
    begin
      if FilMark then
        GetHandles := FilMarkHandles
      else
        GetHandles := MemW[Blocks[bottomBlock].psp:EMScntOffset];
    end {Gethandles} ;

    function GetStoredMap(bottomBlock : BlockType; EMSmapOffset : Integer) : PageArrayPtr;
      {-Returns a pointer to the stored page array}
    begin
      if FilMark then
        GetStoredMap := FilMarkPageMap
      else
        GetStoredMap := Ptr(Blocks[bottomBlock].psp, EMSmapOffset);
    end {GetStoredMap} ;

    procedure EMSpageMap(var PageMap : PageArray; var EMShandles:integer);
      {-return an array of the allocated memory blocks}
    begin
      regs.ah := $4D;
      regs.es := Seg(PageMap);
      regs.di := Ofs(PageMap);
      regs.bx := 0;
      Intr(EMSinterrupt, regs);
      if regs.ah <> 0 then begin
        WriteLn('EMS device not responding');
        emshandles:=0;
      end else
        emshandles:=regs.bx;
    end {EMSpageMap} ;

    procedure ReleaseEMSblocks(var oldmap, newmap : PageArray);
      {-Release those EMS blocks allocated since MARK was installed}
    var
      o, n, nhandle : Integer;

      procedure EMSdeallocate(EMShandle : Integer);
        {-Release the allocated expanded memory}
      begin
        Regs.ah := $45;
        Regs.dx := EMShandle;
        Intr(EMSinterrupt, Regs);
        if Regs.ah <> 0 then begin
          WriteLn('Program error or EMS device not responding');
          Abort('EMS memory may be a mess... Please reboot');
        end;
      end {EMSdeallocate} ;

    begin
      for n := 1 to EMShandles do begin
        {Scan all current handles}
        nhandle := newmap[n].handle;
        if StoredHandles > 0 then begin
          {See if current handle matches one stored by MARK}
          o := 1;
          while (oldmap[o].handle <> nhandle) and (o <= StoredHandles) do
            o := Succ(o);
          {If not, deallocate the current handle}
          if (o > StoredHandles) then
            EMSdeallocate(nhandle);
        end else
          {No handles stored by MARK, deallocate all current handles}
          EMSdeallocate(nhandle);
      end;
    end {ReleaseEMSblocks} ;

  begin
    {Get the existing EMS page map}
    GetMem(Map, 2048);
    EMSpageMap(Map^, EMShandles);
    if EMShandles > MaxHandles then
      WriteLn('EMS process count exceeds capacity of RELEASE - no action taken')
    else if EMShandles <> 0 then begin
      {See how many handles were active when MARK was installed}
      StoredHandles := GetHandles(bottomBlock, EMScntOffset);
      {Get the stored page map}
      StoredMap := GetStoredMap(bottomBlock, EMSmapOffset);
      {Compare the two maps and deallocate pages not in the stored map}
      ReleaseEMSblocks(StoredMap^, Map^);
    end;
  end {RestoreEMSmap} ;

  procedure GetOptions;
    {-Analyze command line for options}
  var
    arg : AllStrings;
    arglen : Byte absolute arg;
    i : Integer;

    procedure WriteHelp;
      {-Show the options}
    begin
      WriteLn('RELEASE ', Version, ', by TurboPower Software');
      WriteLn('====================================================');
      WriteLn('RELEASE removes memory-resident programs from memory');
      WriteLn('and restores the interrupt vectors to their state as');
      WriteLn('found prior to the installation of a MARK.');
      WriteLn('RELEASE manages both normal DOS memory and also');
      WriteLn('Lotus/Intel Expanded Memory. If WATCH has been installed,');
      WriteLn('RELEASE will update the WATCH data area for the TSRs');
      WriteLn('released.');
      WriteLn;
      WriteLn('RELEASE accepts the following command line syntax:');
      WriteLn;
      WriteLn('  RELEASE [MarkName] [Options]');
      WriteLn;
      WriteLn('Options may be preceded by either / or -. Valid options');
      WriteLn('are as follows:');
      WriteLn;
      WriteLn('     /K     release memory, but Keep the mark in place.');
      writeln('     /N     do Not touch EMS memory in any way.');
      WriteLn('     /R     Revector the 8259 interrupt controller to its');
      WriteLn('            powerup state.');
      WriteLn('     /?     write this help screen.');
      Halt(1);
    end {WriteHelp} ;

  begin

    WriteLn;

    {Initialize defaults}
    markName := '';
    Revector8259 := False;
    KeepMark := False;
    DealWithEMS := True;
    ReturnCode := 0;
    TrappedBytes := 0.0;
    Debug := False;

    i := 1;
    while i <= ParamCount do begin
      arg := ParamStr(i);
      if (arg[1] = '?') then
        WriteHelp
      else if (arg[1] = '-') or (arg[1] = '/') then
        case arglen of
          1 : Abort('Missing command option following '+arg);
          2 : case UpCase(arg[2]) of
                '?' : WriteHelp;
                'R' : Revector8259 := True;
                'K' : KeepMark := True;
                'N' : DealWithEMS := False;
                'D' : Debug := True;
              else
                Abort('Unknown command option: '+arg);
              end;
        else
          Abort('Unknown command option: '+arg);
        end
      else
        {Named mark}
        markName := arg;
      i := Succ(i);
    end;

  end {GetOptions} ;

begin

  {Analyze command line for options}
  GetOptions;

  {Get all allocated memory blocks in normal memory}
  FindTheBlocks;

  {Find the last one marked with the MARK idstring, and MarkName if specified}
  if not(FindMark(markName, MarkID, MarkOffset, MemMark, FilMark, bottomBlock)) then
    Abort('No matching marker found, or protected marker encountered.');

  {Find the watch block, if any}
  UseWatch := FindMark('', WatchID, WatchOffset, Junk, Junk, watchBlock);

  {Mark those blocks to be released}
  MarkBlocks(bottomBlock);

  {Get file mark information into memory}
  if FilMark then
    ReadMarkFile(markName);

  {Copy the vector table from the MARK copy}
  CopyVectors(bottomBlock);

  {Update the watch block if requested}
  if UseWatch then
    {The WATCH ID was found in memory}
    if not(Blocks[watchBlock].releaseIt) then
      {Watch itself won't be released}
      UpdateWatch(watchBlock);

  {Release normal memory marked for release}
  ReleaseMem;

  {Deal with expanded memory}
  if DealWithEMS then
    if EMSpresent then
      RestoreEMSmap;

  {Write success message}
  Write('RELEASE ', Version, ' - Memory released above last MARK ');
  if markName <> '' then
    Write('(', StUpcase(markName), ')');
  WriteLn;

  if ReturnCode <> 0 then
    WriteLn(TrappedBytes:0:0, ' bytes temporarily trapped until batch file completes');

  Halt(ReturnCode);
end.